PC Answers 1995 May/PC Answers CD-ROM 7 (Future Publishing) (May 1995).iso/vbits/code/pleas/win/wiper/wiper.frm

Visual Basic Form | 1994-10-06 | 6.3 KB | 192 lines

VERSION 2.00
Begin Form Wiper
   BorderStyle     =   1  'Fixed Single
   Caption         =   "wiper"
   ClientHeight    =   900
   ClientLeft      =   7845
   ClientTop       =   435
   ClientWidth     =   810
   ClipControls    =   0   'False
   ControlBox      =   0   'False
   FontBold        =   -1  'True
   FontItalic      =   0   'False
   FontName        =   "System"
   FontSize        =   9.75
   FontStrikethru  =   0   'False
   FontUnderline   =   0   'False
   Height          =   1305
   Icon            =   0
   Left            =   7785
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   Picture         =   WIPER.FRX:0000
   ScaleHeight     =   900
   ScaleWidth      =   810
   Top             =   90
   Width           =   930
   Begin Label lblExit
      Alignment       =   2  'Center
      Caption         =   "Exit"
      ForeColor       =   &H00000080&
      Height          =   210
      Left            =   0
      TabIndex        =   0
      Top             =   480
      Width           =   495
   End
   Begin Menu mnu_Settings
      Caption         =   "Settings"
      Visible         =   0   'False
      Begin Menu mnu_Code
         Caption         =   "&Code Windows"
         Checked         =   -1  'True
      End
      Begin Menu mnu_Form
         Caption         =   "&Form Windows"
         Checked         =   -1  'True
      End
      Begin Menu mnu_MDI
         Caption         =   "&MDI Window"
         Checked         =   -1  'True
      End
      Begin Menu mnu_sep1
         Caption         =   "-"
      End
      Begin Menu mnu_Debug
         Caption         =   "&Debug"
      End
      Begin Menu mnu_Project
         Caption         =   "P&roject"
      End
      Begin Menu mnu_Properties
         Caption         =   "Pr&operties"
      End
      Begin Menu mnu_Toolbox
         Caption         =   "&Toolbox"
      End
   End
DefInt A-Z
Const GW_HWNDNEXT = 2
Const GW_OWNER = 4
Const WM_SYSCOMMAND = &H112
Declare Function FindWindow Lib "User" (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Integer
Declare Function GetClassName Lib "User" (ByVal hWnd As Integer, ByVal lpClassName As String, ByVal nMaxCount As Integer) As Integer
Declare Function GetNextWindow Lib "User" (ByVal hWnd As Integer, ByVal wFlag As Integer) As Integer
Declare Function GetWindow Lib "User" (ByVal hWnd As Integer, ByVal wCmd As Integer) As Integer
Declare Function SendMessage Lib "User" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long
Dim sBuff As String * 64
Dim iHWnds() As Integer
Dim TPRatio%
Sub Form_Click ()
    WipeDialog "#32770", "View Procedures"
    If mnu_Code.Checked Then WipeWindows "OEBDebug"
    If mnu_Toolbox.Checked Then WipePopup "ToolsPalette"
    If mnu_Project.Checked Then WipePopup "PROJECT"
    If mnu_Debug.Checked Then WipePopup "OFEDT"
    If mnu_Properties.Checked Then WipePopup "wndclass_pbrs"
    If mnu_Form.Checked Then WipeForms "ThunderForm"
    If mnu_MDI.Checked Then WipeForms "ThunderMDIForm"
End Sub
Sub Form_Load ()
    TPRatio% = Screen.TwipsPerPixelX
    Me.Width = 39 * TPRatio%
    Me.Height = (32 * TPRatio%) + (14 * TPRatio%) + (20 * TPRatio%)
    lblExit.Width = 39 * TPRatio%
End Sub
Sub Form_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 2 Then
        PopupMenu mnu_Settings
    End If
End Sub
Sub lblExit_Click ()
    Unload Me
    End
End Sub
Sub mnu_Code_Click ()
    mnu_Code.Checked = Not mnu_Code.Checked
End Sub
Sub mnu_Debug_Click ()
    mnu_Debug.Checked = Not mnu_Debug.Checked
End Sub
Sub mnu_Form_Click ()
    mnu_Form.Checked = Not mnu_Form.Checked
End Sub
Sub mnu_MDI_Click ()
    mnu_MDI.Checked = Not mnu_MDI.Checked
End Sub
Sub mnu_Project_Click ()
    mnu_Project.Checked = Not mnu_Project.Checked
End Sub
Sub mnu_Properties_Click ()
    mnu_Properties.Checked = Not mnu_Properties.Checked
End Sub
Sub mnu_Toolbox_Click ()
    mnu_Toolbox.Checked = Not mnu_Toolbox.Checked
End Sub
Sub WipeDialog (class$, title$)
    hWindow% = FindWindow(class$, title$)
    If hWindow% = 0 Then Exit Sub
    i% = SendMessage(hWindow%, WM_SYSCOMMAND, &HF060, 0&)
    DoEvents
End Sub
Sub WipeForms (class$)
    ReDim iHWnds(100)
    cnt% = 0
    ' Find first ThunderForm, check Owner (not Parent)
    ' May be either design environment or running app
    hWindow% = FindWindow(class$, 0&)
    If hWindow% = 0 Then Exit Sub
    hParent% = GetWindow(hWindow%, GW_OWNER)
    iZot = GetClassName(hParent%, sBuff, Len(sBuff))
    sClass$ = Trim$(Left$(sBuff, iZot))
    If InStr(sClass$, "ThunderMain") Then
        iHWnds(cnt%) = hWindow%
        cnt% = cnt% + 1
    End If
    ' Look through the window chain, saving hWnds.
    ' Closing windows now hoses GetNextWindow().
    For z = 1 To 1000
        hWindow% = GetNextWindow(hWindow%, GW_HWNDNEXT)
        If hWindow% = 0 Then Exit For
        iZot = GetClassName(hWindow%, sBuff, Len(sBuff))
        sClass$ = Trim$(Left$(sBuff, iZot))
        If sClass$ = class$ Then
            hParent% = GetWindow(hWindow%, GW_OWNER)
            iZot = GetClassName(hParent%, sBuff, Len(sBuff))
            sClass$ = Trim$(Left$(sBuff, iZot))
            If InStr(sClass$, "ThunderMain") Then
                iHWnds(cnt%) = hWindow%
                cnt% = cnt% + 1
            End If
        End If
    Next z
    ' Blow away the windows.
    For z = 0 To cnt% - 1
        i% = SendMessage(iHWnds(z), WM_SYSCOMMAND, &HF060, 0&)
    Next z
    DoEvents
End Sub
Sub WipePopup (class$)
    hWindow% = FindWindow(class$, 0&)
    hParent% = GetWindow(hWindow%, GW_OWNER)
    iZot = GetClassName(hParent%, sBuff, Len(sBuff))
    sClass$ = Trim$(Left$(sBuff, iZot))
    If InStr(sClass$, "ThunderMain") Then
        i% = SendMessage(hWindow%, WM_SYSCOMMAND, &HF060, 0&)
    End If
End Sub
Sub WipeWindows (title$)
    ' Repeatedly search window chain; close each one
    Do
        hWindow% = FindWindow(title$, 0&)
        If hWindow% <> 0 Then
            i% = SendMessage(hWindow%, WM_SYSCOMMAND, &HF060, 0&)
            DoEvents
        Else
            Exit Do
        End If
    Loop
End Sub